unit mainunit;

{$mode objfpc}{$H+}
interface

uses
  Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
  registry,
  Menus, ExtCtrls, StdCtrls, Grids, ComCtrls, Inifiles, frmOptions, LibTar,
  lconvencoding;

const
      Lookup = 0;
      IsAnswer = 1;
      QuestionNo = 2;
      LineType = 3;
      Correct = 4;
      Detail = 5;
      Choice = 6;
      Score = 7;

type

  TAnswerPanel = class(TPanel)
    constructor Create(aOwner: TComponent; number : integer; aText : String; buttoncount : integer);
    destructor Destroy;
  public
    procedure ButtonClicked(Sender : TObject);
    Answer  : TLabel;          // Align Client
    APanel  : TPanel;
    Buttons : TRadioGroup;     // All the answers
  end;

  TExamplePanel = class(TAnswerPanel)
    constructor Create(aOwner: TComponent; number : integer; aText : String; buttoncount : integer);
    procedure ExampleClick(Sender : TObject);
  end;

  { TMainForm }

  TMainForm = class(TForm)
    AnswerHeader : TScrollBox;
    btnBack : TButton;
    btnNext : TButton;
    ButtonPanel : TPanel;
    Footer : TLabel;
    footerpanel : TPanel;
    Header : TLabel;
    headerpanel : TPanel;
    Logo : TImage;
    ImageList1 : TImageList;
    MainMenu1: TMainMenu;
    MenuItem1 : TMenuItem;
    mnuInstructions: TMenuItem;
    Middle : TImage;
    middlepanel : TPanel;
    mnuStartTest : TMenuItem;
    mnuSetup : TMenuItem;
    mnuTest : TMenuItem;
    mnuFile: TMenuItem;
    mnuExit: TMenuItem;
    mnuHelp: TMenuItem;
    mnuLoad: TMenuItem;
    mnuAbout: TMenuItem;
    MenuItem5: TMenuItem;
    mnuContents: TMenuItem;
    mnuSave: TMenuItem;
    MenuItem9: TMenuItem;
    FileOpenDialog : TOpenDialog;
    MainPanel : TPanel;
    FileSaveDialog : TSaveDialog;
    Panel1 : TPanel;
    PopupMenu1 : TPopupMenu;
    legend : TPanel;
    procedure btnBackClick ( Sender : TObject ) ;
    procedure btnNextClick ( Sender : TObject ) ;
    procedure btnsUpdate ;
    procedure FormActivate(Sender: TObject);
    procedure FormCloseQuery ( Sender : TObject; var CanClose : boolean ) ;
    procedure FormCreate ( Sender : TObject ) ;
    procedure FormDestroy ( Sender : TObject ) ;
    procedure FormMouseWheelDown ( Sender : TObject; Shift : TShiftState; 
      MousePos : TPoint; var Handled : Boolean ) ;
    procedure FormMouseWheelUp ( Sender : TObject; Shift : TShiftState; 
      MousePos : TPoint; var Handled : Boolean ) ;
    procedure MenuItem1Click ( Sender : TObject ) ;
    procedure mnuInstructionsClick(Sender: TObject);
    procedure mnuAboutClick ( Sender : TObject ) ;
    procedure mnuContentsClick ( Sender : TObject ) ;
    procedure mnuExitClick ( Sender : TObject ) ;
    procedure mnuLoadClick ( Sender : TObject ) ;
    procedure mnuSaveClick ( Sender : TObject ) ;
    procedure mnuSetupClick ( Sender : TObject ) ;
    procedure mnuStartTestClick ( Sender : TObject ) ;
    procedure StringGrid1Click ( Sender : TObject ) ;
    procedure RenderTest(aTest:TStringGrid; Question: integer); 
    procedure ReRenderTest; 
    procedure CreateInstructionsPanel;
  private
    { private declarations }
  public
    InstructionsPanel : TScrollBox;
    examp, epanel : TPanel;
    l1,l2,l3 : TLabel;
    ea,eb,ec,ed : TLabel;
    e1,e2,e3,e4 : TExamplePanel;
    initialized : boolean;
    { public declarations }
  end;

  {TMyRadioPanel = class(Tpanel)  // An align right panel
    constructor Create(aOwner: TComponent; buttoncount:integer);
    buttons : array of TRadioButton;
    destructor Destroy;
  end;}

//  PAnswerPanel = TAnswerPanel^; 



var  // GLOBAL VARIABLES
    AppPath : String;
    Path : String;
    TestName : String;
    FullTestName : String;
    QuestionnaireName : String;
    QuestionnairePosition : String;
    QuestionnaireSavePath : String;
    QuestionnaireTime     : String;
    LegendText : String; 
    Password : String;
    AbcOptions : TStringList; 
    locked : boolean;
    Red,
    Orange,
    Green : Integer;
    ini : TInifile;
    OptionsIni : TInifile;
    csvfs : TMemoryStream;
    imagefs : TMemoryStream;
    Test : TStringGrid;
    AnswersCreated : TList;
    CurrentQuestion : integer;
    QuestionCount : integer;
    TestLoaded : Boolean;
    TestCompleted : Boolean;
    Output : TextFile;
    TA : TTarArchive;
    ImageList : TList;
    ImageNames : TStringlist;
    
Function Encrypt(aString : String):String;
procedure Addlog(s:String; Debug : boolean = false);
procedure loadIni; 
    
var
  MainForm: TMainForm;

implementation

{ TMainForm }
uses Setup, aboutunit, candidate; 

procedure loadini;
var reg : TRegistry;
begin
  if not assigned(ini) then exit;

  reg := TRegistry.Create;
  reg.RootKey := HKEY_CURRENT_USER;
  Reg.OpenKey('Software\ABCQuestionnaire',False);

   
  locked := ini.ReadBool ('General','Locked',true) ;
  red := ini.Readinteger ('General','Red',0) ;
  orange := ini.ReadInteger ('General','Orange',0) ;
  green := ini.ReadInteger ('General','Green',0) ;
  QuestionnaireName := ini.ReadString('General','Name','');
  QuestionnairePosition := ini.ReadString('General','Position','');
  //ShowMessage('QuestionnairePosition = ' + QuestionnairePosition); 
  //QuestionnaireSavePath := ini.ReadString('General','SavePath','');

  QuestionnaireSavePath := reg.ReadString('ResultsPath') ;
  if not DirectoryExists(QuestionnaireSavePath) then
    QuestionnaireSavePath := path;

  QuestionnaireTime := ini.ReadString('General','Time','');
  Password := ini.ReadString('General','Password',encrypt('abc'));
  LegendText := ini.ReadString('General','LegendText','RATING SCALE:  1 - Extremely unlikely; 2 - Very unlikely; 3 - Somewhat unlikely; 4 - Somewhat likely; 5 - Very likely; 6 - Extremely likely'); 

end;

procedure Addlog(s:String; Debug : boolean = false);
begin
  AssignFile(Output,'log.txt');
  if FileExists('log.txt') then
    Append(Output)
  else
    Rewrite(output);
  writeln(Output,'[' + formatdatetime('dd/mm/yy HH:mm',now()) + '] '+ s);
  CloseFile(output);
end;
    
Function Encrypt(aString : String):String;
var Seed : longint;
    i, k  : integer;
    EncryptLength : integer;
begin
  seed := 0;
  
  // Get the seed
  for i := 1 to length(aString) do
    Seed := ord(aString[i]);
        
  // Randomize for the non-random password seed
  RandSeed := Seed;

  // Get the length of the encrypt string
  EncryptLength := 32;
  while length(aString) > EncryptLength do EncryptLength:= EncryptLength*2;
  
  // Add "junk" to the end of the password
  k := length(aString);
  for i := k+1 to EncryptLength do
    aString := aString + chr(random(256)+1);
  
  // Add a random amount to each char.
  // But remember that some characters will mess up if saved in a .ini file7
  for i := 1 to length(aString) do 
    aString[i] := chr( (ord(aString[i])+random(256)) mod 94 + 33 );  
  
  Encrypt := aString;
end; 


Constructor TExamplePanel.Create(aOwner : TComponent; Number : integer; aText : String; ButtonCount : integer);
begin
  inherited create(aOwner, number,aText,ButtonCount);
  Buttons.OnClick := @ExampleClick;
end;

procedure TExamplePanel.ExampleClick(Sender : TObject);
Const varstring : Array [0..5] of string = (
                   '1 - Extremely Unlikely - ',
                   '2 - Very Unlikely - ',
                   '3 - Somewhat Unlikely - ',
                   '4 - Somewhat Likely - ',
                   '5 - Very Likely - ',
                   '6 - Extremely Unlikely - ');
begin
  // Set the right example to the right value!
  with sender as TRadioGroup do begin
    if parent.Name =
    'E1' then Mainform.EA.Caption := 'a) ' + VarString[Buttons.ItemIndex] +
         '(Leave it alone as long as it does not influence your work.)';
    if parent.Name =
    'E2' then Mainform.EB.Caption := 'b) ' + VarString[Buttons.ItemIndex] +
         '(Try to understand the reason for the continued disagreements with your team member.)';
    if parent.Name =
    'E3' then Mainform.EC.Caption := 'c) ' + VarString[Buttons.ItemIndex] +
         '(Complain at your manager.)';
    if parent.Name =
    'E4' then Mainform.ED.Caption := 'd) ' + VarString[Buttons.ItemIndex] +
         '(Ask your team member what her expectations are of you.)';
  end;
end;



constructor TAnswerPanel.Create(aOwner : TComponent; Number : integer; aText : String; ButtonCount : integer);
var i : integer;
begin
  inherited create(aOwner);
  align := alTop;
  bevelouter := bvLowered;
  borderstyle := bsNone; 
  TabStop := false; 
  Height := 40;
  Top := 5000;
  Caption := '';
  BorderSpacing.Around := 4; 
  Buttons := TRadioGroup.Create(self);
  Buttons.TabStop := False;
  Buttons.Align := alRight;
  Buttons.Columns := ButtonCount;
  //Buttons.Caption := 'Extremely Unlikely...Extremely Likely';
  Buttons.Caption := '';
  Buttons.AutoFill := true;
  Buttons.AutoSize := true;
  Buttons.OnClick := @ButtonClicked;

  for i := 0 to ButtonCount - 1 do
    Buttons.Items.Add(inttostr(i+1));

  Buttons.ItemIndex:=-1;
  Buttons.Parent := Self;

  APanel := TPanel.Create(self);
  APanel.Caption := '';
  APanel.BevelOuter := bvNone;
  APanel.Align := alClient;
  APanel.Parent := self; 
  APanel.TabStop := false; 

  Answer := TLabel.create(self); 
  //Answer.Width := 10000; 
  Answer.Alignment := taLeftJustify; 
  Answer.BorderSpacing.left := 4; 
  Answer.Font.Color := clWindowText;
  //Answer.AutoSize := true; 
  Answer.Font.Height := -13;
  Answer.Caption := aText;
  Answer.WordWrap := True;
  Answer.Parent := APanel; 
  AutoSize := true; 
end;

procedure TAnswerPanel.ButtonClicked(Sender : TObject);
var testpos : string;
    i : integer;
    iCorrect, iChoice, iScore : integer;
begin

  // Find the right place in the test to
  testpos := lowercase(inttostr(CurrentQuestion) + Self.Name);
  i := 0;
  while (lowercase(test.cells[Lookup,i]) <> testpos) and (i < Test.RowCount) do inc(i);

  if i > Test.Rowcount then begin
    ShowMessage(testpos + ' not found');
    exit;
  end;

  iChoice := self.Buttons.ItemIndex+1;         // Plus 1, because "correct" is expressed from 1-6, and not 0-5
  Test.cells[Choice,i] := inttostr(iChoice);
  iCorrect := strtointdef(Test.cells[Correct,i],0);

  iScore := 6 - abs(iCorrect - iChoice);
  Test.cells[Score,i] := inttostr(iScore);


end;

destructor TAnswerPanel.destroy;
begin
  Answer.destroy;
  //RadioPanel.Destroy;
  Inherited Destroy;
end;

procedure TMainForm.mnuExitClick ( Sender : TObject ) ;
begin
  application.terminate;
end;


procedure TMainForm.ReRenderTest;
begin
  RenderTest(Test,CurrentQuestion); 
end; 

procedure TMainForm.RenderTest(aTest: TStringGrid; Question : integer);
var i,j, item : integer;
    p : TAnswerPanel;
    exists : boolean;
    max : String;
    buflen : longword;
    ext : string;

begin
  btnsUpdate;
  mnuStartTest.Enabled := false;
  mnuLoad.Enabled := false; 
  
  // Set all elements to not visible // not very effective
  panel1.visible := true;
  Header.Caption := '';
  Middlepanel.Visible := false;
  InstructionsPanel.Visible := false;
  Footer.Caption := '';

  legend.Font := stringTofont(AbcOptions[ord(legendfont)]);
  header.Font := StringToFont(AbcOptions[ord(questionfont)]);
  footer.Font := StringToFont(AbcOptions[ord(questionfont)]);


  if Question > QuestionCount then begin 
    legend.visible := false;
    ButtonPanel.Caption := 'Review';
    Header.Caption := 'If you have time left, you may use the "back" button to review any of your answers, press "Finish" when you''re done'; 
    for i := 0 to AnswersCreated.Count -1 do 
      TAnswerPanel(AnswersCreated[i]).visible := false; 
    // TODO: add review page
    exit; 
  end; 
  
  if Question > 0 then ButtonPanel.Caption := 'Situation ' + inttostr(question);
  if Question = 0 then begin;
    legend.visible := false;
    Panel1.visible := false;
    ButtonPanel.Caption := 'Instructions';
    l1.Font := StringToFont(AbcOptions[ord(questionfont)]);
    l2.Font := StringToFont(AbcOptions[ord(questionfont)]);
    l3.Font := StringToFont(AbcOptions[ord(questionfont)]);
    E1.Answer.Font := StringToFont(AbcOptions[ord(answerfont)]);
    E2.Answer.Font := StringToFont(AbcOptions[ord(answerfont)]);
    E3.Answer.Font := StringToFont(AbcOptions[ord(answerfont)]);
    E4.Answer.Font := StringToFont(AbcOptions[ord(answerfont)]);
    ea.Font := StringToFont(AbcOptions[ord(questionfont)]);
    eb.Font := StringToFont(AbcOptions[ord(questionfont)]);
    ec.Font := StringToFont(AbcOptions[ord(questionfont)]);
    ed.Font := StringToFont(AbcOptions[ord(questionfont)]);

    If assigned(InstructionsPanel) then begin
      InstructionsPanel.Parent := AnswerHeader;
      InstructionsPanel.Visible := true;
      InstructionsPanel.Invalidate;
    end;
    for i := 0 to AnswersCreated.Count -1 do 
      TAnswerPanel(AnswersCreated[i]).visible := false; 
    //TODO : add "default" instructions 
    exit; 
  end;

  legend.visible := true; 
  i := 0; 
  //Gets to the right place 
  //This assumes that the question number is in column 3 
  while (aTest.Cells[QuestionNo,i] <> InttoStr(Question)) and (i < aTest.RowCount) do 
    inc(i);  

  max := '';
  while (i < aTest.RowCount ) do begin 
  if (aTest.Cells[QuestionNo,i] = InttoStr(Question)) then 
  begin
    // It's a header line 
    if lowercase(aTest.Cells[LineType,i]) = 'header' then begin
      header.Caption := aTest.Cells[Detail,i];
      headerpanel.Top := ButtonPanel.top + 10;
      headerpanel.visible := true;

    end;
    // It's a middle line 
    if lowercase(aTest.Cells[LineType,i]) = 'middle' then begin
      item := -1;
      exists := false;
      while (item < ImageNames.Count -1) and (not exists) do
      begin
        inc(item);
        if lowercase(aTest.Cells[Detail,i]) = lowercase(ImageNames[item]) then exists := true;
      end;

      //imagefs := TmemoryStream(Imagelist[item]^);
      //imagefs := Zip.GetFileStream(aTest.Cells[Detail,i], buflen);
      //ext := ExtractFileExt(aTest.Cells[Detail,i]);
      if exists then begin
        //showmessage('display pic');
        middle.picture := TPicture(ImageList[item]);
        middlepanel.Top := ButtonPanel.top + headerPanel.Top + 10;
        middlepanel.visible := true;
      end;
    end;
    // It's a footer line 
    if lowercase(aTest.Cells[LineType,i]) = 'footer' then begin
      footer.Caption := aTest.Cells[Detail,i];
      footerpanel.Top := ButtonPanel.top + headerpanel.Top + middlepanel.Top + 10;
      footerpanel.visible := true;

    end;
  
    // It's an answer line 
    if lowercase(aTest.Cells[IsAnswer,i]) = 'true' then begin
      // Set the biggest  
      if lowercase(aTest.Cells[LineType,i]) >= max then max := lowercase(aTest.Cells[LineType,i]);
      exists := false; 
      for j := 0 to AnswersCreated.count -1 do begin 
        if TAnswerPanel(AnswersCreated[j]).name = aTest.Cells[LineType,i] then begin 
          exists := true; 
          p := TAnswerPanel(AnswersCreated[j]); 
          continue; 
        end;
      end; 
      if not exists then begin   
        p := TAnswerPanel.Create(nil,Question,'',6);
        p.Name := aTest.Cells[LineType,i];
        max := lowercase( aTest.Cells[LineType,i]); 
        p.Answer.Alignment := taLeftJustify;
        AnswersCreated.Add(p); 
        p.Parent := AnswerHeader;
        p.Answer.Align := alClient;
        //p.Buttons.TabStop := true;  // Does this help?
      end;
      p.Answer.Visible := true; 
      p.Answer.Caption := aTest.Cells[LineType,i] + ') ' + aTest.Cells[Detail,i];
      p.Answer.Font := StringToFont(AbcOptions[ord(answerfont)]); 
      p.Buttons.ItemIndex := strtointdef(aTest.cells[Choice,i],0)-1;
      p.Top := 10000; 
      p.visible := true; 
    end;  
    end; // if 
    inc(i); 
    end; // while 

   for j := 0 to AnswersCreated.Count -1 do begin
     if TAnswerPanel(AnswersCreated[j]).name > max then
       TAnswerPanel(AnswersCreated[j]).Visible := false; 
   end;

   if header.Caption = '' then headerpanel.visible := false;
   if footer.Caption = '' then footerpanel.visible := false;

end; 


procedure TMainForm.btnsUpdate;
begin
  if CurrentQuestion = 0 then btnBack.enabled := false else btnBack.Enabled := true;
  // if we're at review
  if CurrentQuestion = QuestionCount + 1 then btnNext.Caption := 'Finish' else 
  if CurrentQuestion = QuestionCount then btnNext.Caption := 'Review' else
  btnNext.Caption := 'Next';
  
end;

procedure TMainForm.FormActivate(Sender: TObject);
begin
  if initialized then exit;
  initialized := true;
end;

procedure TMainForm.FormCloseQuery ( Sender : TObject; var CanClose : boolean 
 ) ;
begin
  CanClose := true;
  // If the test is being "rendered"
  if (MainPanel.Visible) and (not testcompleted) then begin
  if Messagedlg('Test in progress!',
                'All changes will be lost, and your results will not be recored!'+chr(13)+
                'Are you sure you want to quit?',mtWarning,[mbYes,mbCancel],1) <> mrYes 
  then 
    CanClose := false;
  end
  else
  if Messagedlg('ABC Questionnaire',
                'Are you sure you want to quit?',mtWarning,[mbYes,mbCancel],1) <> mrYes 
  then
    CanClose := false;
end;

procedure TMainForm.btnNextClick ( Sender : TObject ) ;
var j : integer;
    AllFilledIn : boolean;
    tempini : Tinifile;
    candidatescore,c : integer;
    r, answers, CorrectAnswers : string;
    CandName : String;
    shift : TShiftState;
    
begin
  shift := GetKeyShiftState;
  AllFilledIn := True;
  for j := 0 to AnswersCreated.Count -1 do
  if TAnswerPanel(AnswersCreated[j]).visible then
  if TAnswerPanel(AnswersCreated[j]).Buttons.ItemIndex = -1 then AllFilledIn := False;

  if (not AllFilledIn) {and (not (ssCtrl in Shift))}  then begin
    messagedlg(Application.Name,'You must fill in all the questions before you can continue',mtError,[mbOK],1);
    exit;
  end;

  // 1 bigger than question count should take you to review.
  if (btnNext.Caption = 'Next') or (btnNext.Caption = 'Review') then
  if CurrentQuestion <= QuestionCount then
  begin
    CurrentQuestion := CurrentQuestion + 1;
    RenderTest(Test,CurrentQuestion); 
    exit; 
  end; 

 
  if btnNext.Caption = 'Finish' then begin
    if not directoryexists(QuestionnaireSavePath) then 
      tempini := Tinifile.Create(TestName + '.results')
    else
      tempini := Tinifile.Create(QuestionnaireSavePath + PathDelim + TestName + '.results');
      
    candidatescore := 0;
    
    Answers := '';
    CorrectAnswers := '';
    for j := 0 to Test.RowCount -1 do
      if lowercase(Test.Cells[IsAnswer,j]) = 'true' then  begin
      
      Answers := Answers + Test.Cells[Choice,j] + ',';
      CorrectAnswers := CorrectAnswers + Test.Cells[Correct,j] + ',';
      
      c := strtointdef(Test.Cells[Score,j],0);
      candidatescore := candidatescore + c;
    end;
    
    r := '';
    if candidatescore > Orange then r := 'Green';
    if (candidatescore > Red) and (candidatescore <= Orange) then r := 'Orange';
    if candidatescore <= red then r := 'Red';
    
    CandName := CandidateForm.bxName.text + ' ' + CandidateForm.bxSurname.text + ' - ' + FormatDateTime('yyyy-mm-dd',date());
    tempini.WriteInteger(CandName,'Score',CandidateScore);
    tempini.WriteString(CandName,'Result',r);
    tempini.WriteString(CandName,'Title',CandidateForm.bxTitle.text);
    tempini.WriteString(CandName,'Name',CandidateForm.bxName.text);
    tempini.WriteString(CandName,'Surname',CandidateForm.bxSurname.text);
    tempini.WriteString(CandName,'Date',FormatDateTime('yyyy-mm-dd',date()));
    tempini.WriteString(CandName,'Race',CandidateForm.bxRace.text);
    tempini.WriteString(CandName,'Age',CandidateForm.bxAge.text);
    tempini.WriteString(CandName,'Language',CandidateForm.bxLanguage.text);
    tempini.WriteString(CandName,'Gender',CandidateForm.bxGender.text);
    tempini.Writestring(CandName,'TestAnswers',Answers);
    tempini.Writestring(CandName,'CorrectAnswers',CorrectAnswers);
     
    //Addlog('Candidate saved to ' + QuestionnaireSavePath + PathDelim + TestName + '.results');
    ShowMessage('You have successfully completed the test!');
    TestCompleted := true;
    mainpanel.Visible :=false;     
    tempini.free;
  end;
  btnsUpdate;
end;

procedure TMainForm.btnBackClick ( Sender : TObject ) ;
begin
  if CurrentQuestion > 0 then  begin  
    CurrentQuestion := CurrentQuestion - 1;
    RenderTest(Test,CurrentQuestion);     
  end;
  btnsUpdate;
end;

procedure TMainForm.CreateInstructionsPanel;
var total : integer;
begin
    InstructionsPanel := TScrollbox.Create(AnswerHeader);
    InstructionsPanel.Caption := '';
    InstructionsPanel.Align := alClient;
    InstructionsPanel.AutoScroll:= true;

    l1 := TLabel.Create(InstructionsPanel);
    l1.wordwrap := true;
    l1.BorderSpacing.Around:=4;
    l1.visible := true;
    l1.Align := alTop;
    l1.Caption :=
    'GENERAL' + chr(13) + chr(13) +

    'The purpose of this test is to assess how you would most likely behave in the workplace.' + chr(13) + chr(13) +

    'In this test you have to take on the role of ' + QuestionnairePosition + ' and make decisions that form ' +
    'part of their daily responsibility. You will be presented with a number of passages about ' +
    'typical ' + QuestionnairePosition + ' situations, as well as statements of possible responses/actions in each ' +
    'situation. Your task is to indicate how likely you would perform each behaviour or response ' +
    'in the situations described.' + chr(13) + chr(13) +

    'You should rate the likelihood of you performing each response on a 6-point scale ranging ' +
    'from 1 (extremely unlikely) to 6 (extremely likely). Look at the scale below and make sure ' +
    'you understand the different ratings.' + chr(13) + chr(13) +
    '1  =  Extremely unlikely' + chr(13) +
    '2  =  Very unlikely' + chr(13) +
    '3  =  Somewhat unlikely' + chr(13) +
    '4  =  Somewhat likely' + chr(13) +
    '5  =  Very likely' + chr(13) +
    '6  =  Extremely likely' + chr(13) + chr(13) +

    'SELECTING YOUR ANSWER (OPERATING CONTROLS)' + chr(13) + chr(13) +

    'To select an answer:' + chr(13) + chr(13) +

    'Please read each statement carefully, and then select your answer by clicking with the mouse ' +
    'pointer on the bubble of your choice (Help: Point the mouse cursor over the bubble and gently ' +
    'press and release the left mouse button). Alternatively, you can use the left/right arrow keys ' +
    'on the keyboard to move between the bubbles and press the TAB button to select your answer and ' +
    'move down to the next row of bubbles.' + chr(13) + chr(13) +

    'To change an answer: ' + chr(13) + chr(13) +

    'Should you want to change your answer, click with the mouse pointer on the new answer as this ' +
    'will automatically cancel out your initial answer. If you are using the keyboard, you can go ' +
    'back to a previous question (response/statement) by holding in the SHIFT button while pressing ' +
    'TAB. Then use the left/right arrow keys to move to the bubble you want to change your answer to ' +
    'and press TAB to the select the bubble.' + chr(13) + chr(13) +

    'To move to another situation or screen:' + chr(13) + chr(13) +

    'In order to start with a new scenario/situation you are required to answer all the ' +
    'responses/statements and click with the mouse pointer on the NEXT button on the top right-hand ' +
    'side of the screen. If using the keyboard you need to press TAB until the NEXT button on the ' +
    'screen is highlighted and then press the ENTER button on the keyboard. You can also move back ' +
    'to a previous scenario/situation by clicking with the mouse pointer on the BACK button on the ' +
    'top left-hand side of the screen.' + chr(13) + chr(13) +

    'EXAMPLE' + chr(13) + chr(13) +

    'Complete the following the example question.' + chr(13) + chr(13) +
    'Situation: You have constant disagreements with one of your team members over small ' +
    '(unimportant) things.' + chr(13) +
    'Rate how likely you would perform each of the following behaviours:';
    l1.parent := InstructionsPanel;


    ePanel := TPanel.Create(InstructionsPanel);
    ePanel.align := alTop;
    ePanel.caption := '';
    ePanel.AutoSize := true;
    ePanel.visible := true;
    ePanel.BevelOuter := bvNone;
    ePanel.BorderSpacing.Around:=4;
    ePanel.parent := InstructionsPanel;

    //Create(aOwner : TComponent; Number : integer; aText : String; ButtonCount : integer);
    E1 := TExamplePanel.Create(nil,1,
      'a) Leave it alone as long as it does not influence your work.',6);
      E1.name := 'E1';
      E1.Answer.Alignment := taLeftJustify;
      E1.Answer.Align := alClient;
      E1.Answer.Visible := true;;
      E1.Visible := true;
      E1.Top := 1;
      E1.Parent := Epanel;

    E2 := TExamplePanel.Create(nil,2,
      'b) Try to understand the reason for the continued disagreements with your team member.',6);
      E2.name := 'E2';
      E2.Answer.Alignment := taLeftJustify;
      E2.Answer.Align := alClient;
      E2.Answer.Visible := true;
      E2.Visible := true;
      E2.Top := 50;
      E2.Parent := Epanel;

    E3 := TExamplePanel.Create(nil,3,
      'c) Complain at your manager.',6);
      E3.name := 'E3';
      E3.Answer.Alignment := taLeftJustify;
      E3.Answer.Align := alClient;
      E3.Answer.Visible := true;
      E3.Visible := true;
      E3.Top := 100;
      E3.Parent := Epanel;

    E4 := TExamplePanel.Create(nil,4,
      'd) Ask your team member what her expectations are of you.',6);
      E4.name := 'E4';
      E4.Answer.Alignment := taLeftJustify;
      E4.Answer.Align := alClient;
      E4.Answer.Visible := true;
      E4.Visible := true;
      E4.Top := 150;
      E4.Parent := Epanel;

    l2 := TLabel.Create(InstructionsPanel);
    l2.wordwrap := true;
    l2.BorderSpacing.Around:=4;
    l2.Align := alTop;
    l2.visible := true;
    l2.Caption :=
    'In this example you indicated that the likelihood of you performing each of ' +
    'the response options are as follows:' + chr(13);
    l2.parent := InstructionsPanel;

    examp := TPanel.Create(InstructionsPanel);
    examp.align := alTop;
    examp.caption := '';
    examp.AutoSize := true;
    examp.visible := true;
    examp.parent := InstructionsPanel;
    examp.BorderSpacing.InnerBorder:=4;
    examp.BorderSpacing.Around:=4;
    examp.bevelouter := bvLowered;

    ea := TLabel.Create(examp);

    //ea.wordwrap := true;
    ea.Align := alTop;
    ea.visible := true;
    ea.BorderSpacing.Around:=4;
    ea.Caption :=
    'a) (Leave it alone as long as it does not influence your work.)';
    ea.parent := examp;

    eb := TLabel.Create(examp);
    //eb.wordwrap := true;
    eb.BorderSpacing.Around:=4;
    eb.Align := alTop;
    eb.visible := true;
    eb.Caption :=
    'b) (Try to understand the reason for the continued disagreements with your team member.)';
    eb.parent := examp;

    ec := TLabel.Create(Examp);
    ec.BorderSpacing.Around:=4;
    //ec.wordwrap := true;
    ec.Align := alTop;
    ec.visible := true;
    ec.Caption :=
    'c) (Complain at your manager.)';
    ec.parent := Examp;

    ed := TLabel.Create(Examp);
    //ed.wordwrap := true;
    ed.BorderSpacing.Around:=4;
    ed.Align := alTop;
    ed.visible := true;
    ed.Caption :=
    'd) (Ask your team member what her expectations are of you.)';
    ed.parent := Examp;

    l3 := TLabel.Create(InstructionsPanel);
    l3.wordwrap := true;
    l3.BorderSpacing.Around:=4;
    l3.Align := alTop;
    l3.visible := true;
    l3.Caption := chr(13) +
    'Now, practice how to change your initial answer by selecting a different answer ' +
    'this time. Remember, to change your answer you need to click with the mouse ' +
    'pointer on the new answer as this will automatically cancel out your initial ' +
    'answer. If you are using the keyboard, you can go back to a previous question ' +
    '(response/statement) by holding in the SHIFT button while pressing TAB. Then use ' +
    'the left/right arrow keys to move to the bubble you want to change your answer to ' +
    'and press TAB to the select the bubble.' + chr(13) + chr(13) +

    'There are a many different situations in this test, each with a number of responses ' +
    'that have to be rated.' + chr(13) + chr(13) +

    'You have ' + questionnairetime + ' in which to complete the test. You are allowed to ' +
    'review your answers if you complete the test before the time is over. ' + chr(13) + chr(13) +

    'IMPORTANT' + chr(13) + chr(13) +

    '* The information in the passages is limited, but read it carefully and try your best to provide an answer.' + chr(13) +
    '* Although each response option for a particular situation should be rated independent from ' +
      'the other response options of the same situation (in other words, on its own merits), it ' +
      'gives one perspective when first reading through all the responses before giving a rating.' + chr(13)+
    '* It is possible to give the same likelihood rating to two different responses of the same situation.' + chr(13) +
    '* Each situation should be seen as unique, unrelated to any other situation in the test.'  + chr(13) +
    '* The best way to answer this test is to be as honest as possible.'  + chr(13) +
    '* Make sure to rate ALL the responses even if you are unsure about the likelihood of your behaviour.' +chr(13) + chr(13) +
    ' --===-- PLEASE ASK NOW IF THERE IS ANYTHING THAT YOU DO NOT UNDERSTAND --===--';
    l3.parent := InstructionsPanel;

    l1.autosize := true;
    l2.autosize := true;
    ea.autosize := true;
    eb.autosize := true;
    ec.autosize := true;
    ed.autosize := true;
    examp.autosize := true;
    l3.autosize := true;
    total := l1.Height;
    l2.top := total + 1;
    total := total + l2.Height + 1;
{    ea.top := total + 1;
    total := total + ea.Height + 1;
    eb.top := total + 1;
    total := total + eb.Height + 1;
    ec.top := total + 1;
    total := total + ec.Height + 1;
    ed.top := total + 1;
    total := total + ed.Height + 1;;}
    examp.top := total + 1;
    total := total + examp.height + 1;
    l3.top := total + 1;
    total := total + l3.Height + 1;
end;

procedure TMainForm.FormCreate ( Sender : TObject ) ;
begin
  Test := TStringGrid.Create(nil);
  AnswersCreated := TList.Create; 
  Test.AutoFillColumns := true; 
  TestLoaded := false; 
  TestCompleted := false;
  MainPanel.Visible := TestLoaded;
  AppPath := ExtractFilePath(Application.Exename); 
  AbcOptions := TStringList.Create;
  //CreateInstructionsPanel;
end;

procedure TMainForm.FormDestroy ( Sender : TObject ) ;
begin
  Test.Free; 
end;

procedure TMainForm.FormMouseWheelDown ( Sender : TObject; Shift : TShiftState; 
  MousePos : TPoint; var Handled : Boolean ) ;
begin
  if ssctrl in shift then begin
      // Zoom Text Smaller 

  end; 
end;

procedure TMainForm.FormMouseWheelUp ( Sender : TObject; Shift : TShiftState; 
  MousePos : TPoint; var Handled : Boolean ) ;
begin
  if ssctrl in shift then begin
    // Zoom Text Bigger 

  end;
end;

procedure TMainForm.MenuItem1Click ( Sender : TObject ) ;
begin
  Options.showmodal; 
end;

procedure TMainForm.mnuInstructionsClick(Sender: TObject);
begin
  // Open up the instrutions
end;

procedure TMainForm.mnuAboutClick ( Sender : TObject ) ;
begin
  AboutForm.Show;
end;

procedure TMainForm.mnuContentsClick ( Sender : TObject ) ;
begin
  // Point browser to documentation...
  ShowMessage('Not implemented yet, will open a browser to the user documentation');
  
end;




procedure TMainForm.mnuLoadClick ( Sender : TObject ) ;

  function AddQuotes(s:string):String;
  var res : string;
      addstr : string; 
      done : boolean;
      i : integer; 
  begin
    res := '';
    done := false;
    i := -1;    
    s := StringReplace(S,',,',',"",',[rfReplaceAll]); 
    
    while not done do 
    begin 
      inc(i);
      // Add " to the start and the end of the string 
      if i <> 5 then  begin 
        addstr := copy(s,1,pos(',',s)-1);
        {if length(addstr) < 1 then begin res := res + addstr; continue; end; 
        if not (addstr[1] in ['"',',']) then begin
          if addstr[1] <> ',' then addstr := '"' + addstr;
          if addstr[length(addstr)] <> '"' then addstr := addstr + '"';
        end; 
        res := res + addstr;} 
        res := res + addstr + ',';  
      end 
      else begin
        // it IS the detail - just add the detail
        if length(s) >= 1 then begin
          if (s[1] = '"') and (s[length(s)] = '"') then begin
          s := copy(s,2,length(s));
          s := copy(s,1,length(s)-1);
        end;
        s := StringReplace(s,'"','""',[rfReplaceAll, rfIgnoreCase]);
        s := '"' + s + '"';
        end;

        res := res + s;
        done := true;
      end;
       
      if pos(',',s) > 0 then 
        s := copy(s,pos(',',s)+1,length(s))
      else begin 
        //res := res + s;
        done := true;
      end; 
    end;
     
    Addquotes := res;   
  end;

  function fixUTFstuff(s :string):string;
  begin
    // “”
    {s := stringReplace(s,chr(148),'"',[rfReplaceAll, rfIgnoreCase]);
    s := stringReplace(s,chr(147),'"',[rfReplaceAll, rfIgnoreCase]);
    s := stringReplace(s,chr(150),'--',[rfReplaceAll, rfIgnoreCase]);
    s := stringReplace(s,chr(145),'''',[rfReplaceAll, rfIgnoreCase]); 
    s := stringReplace(s,chr(146),'''',[rfReplaceAll, rfIgnoreCase]);
    s := stringReplace(s,chr(233),'é',[rfReplaceAll, rfIgnoreCase]);
    }
    s := CP1250ToUTF8(s);
                                  
    fixUTFstuff := s;
  end;
  function removequotes(s:string):string;
  begin
    if length(s) <= 1 then begin
      removequotes := s;
      exit;
    end; 
    if (s[1] = '"') and (s[length(s)] = '"') then begin
      s := copy(s,2,length(s));
      s := copy(s,1,length(s)-1);
    end;
    removequotes:=s; 
  end; 
  
    
var rows : TStringList; 
    cols : TStringList; 
    row,col,tmppos : integer;
    buflen : longword;
    locked : boolean;
    DirRec : TTarDirRec;
    inistream : TStream;
    imagestream : TStream;
    tempPic : TPicture;
    csvstream : TStream;
    csvstr : string;
    tmpstr : string;
    ext : string;
    fn : string;
begin                              
  // Load files of new type?  Will have to be the zip file without compression
  if FileOpenDialog.Execute then begin
    mnuSetup.Enabled := true;
    {
    zip.filename := FileOpenDialog.FileName ;

    zip.Activate ;}
    TA := TTarArchive.Create(FileOpenDialog.FileName);
    TA.Reset;

    rows := TStringList.Create;
    cols := TStringList.Create;
    ImageList := TList.Create;
    iniStream := TMemoryStream.Create;
    ImageNames := TStringlist.create;
    csvstream := TMemorystream.create;


    While TA.FindNext (DirRec) do begin
      // it's the data file
      fn := DirRec.Name;
      if pos('.csv',lowercase(fn)) > 0 then begin
        csvstr := TA.ReadFile;
        //TA.ReadFile(csvstream);
      end
      // it's the ini file
      else if pos('.ini',lowercase(fn)) > 0 then begin
        tmpstr := TA.ReadFile;
        inistream.Write(tmpstr[1],length(tmpstr));
        inistream.position := 0; 

        //Addlog('ini file loaded');
        //Showmessage('ini file loaded');
      end
      // it's an image file
      else begin
        {imageStream := TMemoryStream.Create;
        ImageNames.Add(lowercase(DirRec.Name));
        tmpstr := TA.ReadFile;
        ImageStream.Write(tmpstr[1],length(tmpstr));
        ImageList.Add(ImageStream);
        ImageStream.Free;}
        TempPic := TPicture.Create;
        imageStream := TMemoryStream.Create;
        tmpstr := TA.ReadFile;
        ImageStream.Write(tmpstr[1],length(tmpstr));
        ImageStream.Position := 0;
        //TA.ReadFile(ImageStream);

        ext := ExtractFileExt(DirRec.Name);
        ImageNames.Add(lowercase(DirRec.Name));
        TempPic.LoadFromStreamWithFileExt(imagestream,ext);
        ImageList.Add(TempPic);
        ImageStream.Free;
      end;
    end;
    TA.Free;


    path := ExtractFilePath(fileopendialog.FileName);
    TestName := ChangeFileExt(ExtractFileName(fileopendialog.FileName),'');
    FullTestName := path + pathdelim + testname;
    ini := TInifile.Create(inistream);
    Loadini;

    CreateInstructionsPanel;





    csvstr := fixUTFstuff(csvstr);
    rows.text := csvstr;
    
    row := -1; 

    tmpstr := '';
    tmppos := 0; 
    Test.RowCount := rows.count; 
    for row := 0 to rows.Count -1 do begin
      cols.CommaText := Addquotes(Rows[row]);
      if Test.ColCount < Cols.Count then Test.Colcount := Cols.count; 
      for col := 0 to Cols.Count - 1 do begin
        Test.Cells[col,row] := cols[col];

      end;
    end; 
     
    //addlog('test loaded');

    // +1 for the selected answer, and another +1 for the points allocated
    Test.ColCount := Test.ColCount + 2;
       
    // Set the amount of questions.  THIS ASSUMES that the questions has been set sequencially 
    row := rows.count; 
    tmppos := 0; 
    while (row > 0) and (tmppos = 0) do begin
      dec(row); 
      tmppos := strtointdef(Test.Cells[questionno,row],0); 
    end; 
    //showmessage(inttostr(tmppos));  
    QuestionCount := tmppos;


    CurrentQuestion := 0;
    TestLoaded := true;
    MainPanel.Visible := TestLoaded;

    // Start showing the instructions
    RenderTest(Test,0);
    ReRenderTest;
    // but get the candidate's information first
    CandidateForm.ShowModal;


    {if fileexists(FullTestName + '.ini') or
       fileexists (AbcOptions[ord(inipath)] + testname + '.ini')
    then begin
      if fileexists (AbcOptions[ord(inipath)] + testname + '.ini') then
        ini := TInifile.Create(AbcOptions[ord(inipath)] + testname + '.ini')
      else
        ini := TInifile.Create(FullTestName + '.ini');
                 
      LoadIni;      

      //Read Questionnaire locked
      if locked then begin 
        CurrentQuestion := 0;
        TestLoaded := true; 
        MainPanel.Visible := TestLoaded;
              // Start showing the instructions 
      RenderTest(Test,0); 
      // but get the candidate's information first 
      CandidateForm.ShowModal;

      exit;
      end
      // Questionnaire is not locked
      else begin
        setupform.showmodal;
      end;
    end
    // File does not exist!
    else begin
      if DirectoryExists (AbcOptions[ord(inipath)]) then
        ini := TInifile.Create(AbcOptions[ord(inipath)] + testname + '.ini')
      else
        ini := TInifile.Create(FullTestName + '.ini');
          
      ini.WriteBool('General','Locked',false) ;
      ini.WriteInteger('General','Red',0);
      ini.WriteInteger('General','Orange',0);
      ini.WriteInteger('General','Green',0);
      ini.WriteString('General','Name',' ');
      ini.WriteString('General','Position',' ');
      ini.WriteString('General','SavePath',' ');
      ini.WriteString('General','Password',Encrypt('abc'));
      ini.WriteString('General','LegendText','RATING SCALE:  1 - Extremely unlikely; 2 - Very unlikely; 3 - Somewhat unlikely; 4 - Somewhat likely; 5 - Very likely; 6 - Extremely likely');
      
            
      LoadIni;

      setupform.formshow;
      if MessageDlg('Test','Do you want to run the test now?',mtInformation,[mbyes,mbno],1) = mrNo then exit;
      CurrentQuestion := 0;
      TestLoaded := true; 
      MainPanel.Visible := TestLoaded;

      // Start showing the instructions 
      RenderTest(Test,0); 
      // but get the candidate's information first 
      CandidateForm.ShowModal;

      exit;
    end;}
  end; 
end;

procedure TMainForm.mnuSaveClick ( Sender : TObject ) ;
begin
  // Save file of new type.  Cannot save as, because this is not the "editor".
  if FileSaveDialog.Execute then begin 
  end; 
end;

procedure TMainForm.mnuSetupClick ( Sender : TObject ) ;
var ps : string ;
begin
  // Open the setup form for the current open mnuTest (TODO: include security)
  if locked then begin
    ps := PasswordBox('This file is locked','Enter password to Open') ;
    if encrypt(ps) = password then 
      //setupform.formshow
    else
      showmessage('The password does not match');
  end  
  else 
   //setupform.formshow;
end;

procedure TMainForm.mnuStartTestClick ( Sender : TObject ) ;
begin

end;

procedure TMainForm.StringGrid1Click ( Sender : TObject ) ;
begin
 
end;

initialization
  {$I mainunit.lrs}

end.

